
;;;
;;; Property Lists implemented for Scheme
;;;
;;; Copyright 2016,2017 Jason K. MacDuffie
;;; License: GPLv3+
;;;

;; Example: '(pine cons numbers (1 2 3) color "blue")

(define (search-property-list equivalence)
  (lambda (key plist)
    (cond
     ((null? plist) #f)
     ((equivalence key (car plist))
      plist)
     ((null? (cdr plist))
      #f)
     (else
      ((search-property-list equivalence) key (cddr plist))))))

(define propq (search-property-list eq?))
(define propv (search-property-list eqv?))
(define property (search-property-list equal?))

(define (option key props default)
  (let ((result (propq key props)))
    (if result (cadr result) default)))

(define (plist-ref l prop)
  (define x (property prop l))
  (if x
      (cadr x)
      (error "plist-ref" "Property not found" l prop)))

(define (plist-get l prop default)
  ;; This is useful for getting keyword arguments
  (define x (property prop l))
  (if x (cadr x) default))

(define (plist-set-recurse l prop val)
  (if (null? l)
      (error "plist-set-recurse" "Property not found" l prop)
      (if (eq? (car l) prop)
          (cons prop (cons val (cddr l)))
          (cons (car l)
                (cons (cadr l)
                      (plist-set-recurse (cddr l) prop val))))))

(define (plist-set l prop val)
  ;; This procedure can add values if they do not exist
  (if (property prop l)
      (plist-set-recurse l prop val)
      (cons prop (cons val l))))

(define (plist-set! l prop val)
  ;; This procedure will raise an error if prop does not exist
  (define x (property prop l))
  (if x
      (set-car! (cdr x) val)
      (error "plist-set!" "Property not found" l prop)))

(define (plist-delete-recurse l prop)
  (if (null? l)
      (error "plist-delete-recurse" "Property not found" l prop)
      (if (eq? (car l) prop)
          (cddr l)
          (cons (car l)
                (cons (cadr l)
                      (plist-delete-recurse (cddr l) prop))))))

(define (plist-delete l prop)
  (if (property prop l)
      (plist-delete-recurse l prop)
      (error "plist-delete" "Property not found" l prop)))

(define (plist-properties l)
  (if (null? l)
      '()
      (cons (car l) (plist-properties (cddr l)))))

(define (plist-send l message . values)
  ;; This procedure exists for the possibility of object-like
  ;; use of plists
  (apply (plist-ref l message) l values))

;; It may be convenient to convert to and from alist
(define (plist->alist l)
  (if (null? l)
      l
      (cons (cons (car l)
                  (cadr l))
            (plist->alist (cddr l)))))

(define (alist->plist l)
  (if (null? l)
      l
      (cons (caar l)
            (cons (cdar l)
                  (alist->plist (cdr l))))))

